REM *** FFT11.03A - Q (=2^N) POINT PFFFT  ***

REM THIS PROGRAM IS A FREQUENCY ANALYZER USED TO ANALYZE DIGITAL AUDIO

REM FOR NON-LINEAR DISTORTION.

10 SCREEN 9, 1: COLOR 15, 1: CLS 'SETUP DISPLAY SCREEN

11 GOSUB 10000' GIVE 'EM A BREAK

12 QX = 2 ^ 12: QI = 2 ^ 6: WSF = 16 / 5' MAX & NOM ARRAY SIZE & WTNG SF CORR.

16 DIM C(2, QX), S(2, QX), KC(QX / 2), KS(QX / 2)'DIM MAX DATA AND TWIDDLE

18 PI = 3.141592653589793#: P2 = 2 * PI: NYQ = 22050: ASCAN = 0

20 WEXP = 6: FRACF = 1 ' WEIGHTING EXP = 6 & FRACT FREQ = 1/1

24 IOFLG = 2: WTFLG = 2: GAIN = 1: AMP = 1 ' GRAPHIC DISP ON, WEIGHT ON

26 GOSUB 875 ' SETUP INITIAL ARRAY SIZE TO 2^10

28 GOTO 600



99  REM ***********

100 REM *** FFT ***

101 REM ***********

102 T9 = TIMER' GET STARTING TIME

104 REM                *** STAGE A ***

106 FOR I = 0 TO Q2 - 1: I2 = 2 * I

108 C(T0, I2) = (C(T1, I) + C(T1, Q2 + I)) / 2

110 C(T0, I2 + 1) = (C(T1, I) - C(T1, Q2 + I)) / 2

112 NEXT I

114 REM                *** STAGE B ***

116 FOR I = 0 TO Q2 - 1 STEP 2: I2 = 2 * I: IQ2 = I + Q2

118 C(T1, I2) = (C(T0, I) + C(T0, IQ2)) / 2

120 C(T1, I2 + 1) = (C(T0, I + 1)) / 2: S(T1, I2 + 1) = (C(T0, IQ2 + 1)) / 2

122 C(T1, I2 + 2) = (C(T0, I) - C(T0, IQ2)) / 2

124 NEXT I

130 REM                *** REMAINING STAGES ***

132 FOR M = 2 TO N - 1: QT = 2 ^ (M - 1)' STAGE COUNTER

134 QT2 = 2 * QT: KT1 = 2 ^ (N - M - 1)

136 FOR I = 0 TO Q3 STEP QT2: I2 = 2 * I: K = I + Q2

138 REM * COMPUTE DIRECT COMPONENTS *

140 FOR J = 0 TO QT: JA = J + I: JA2 = J + I2: KT = J * KT1: KJ = K + J

142 C(T0, JA2) = (C(T1, JA) + C(T1, KJ) * KC(KT) - S(T1, KJ) * KS(KT)) / 2

144 S(T0, JA2) = (S(T1, JA) + C(T1, KJ) * KS(KT) + S(T1, KJ) * KC(KT)) / 2

146 NEXT J

150 REM * COMPUTE LATENT COMPONENTS *

152 FOR J = QT + 1 TO QT2: JA = I + QT2 - J: JA2 = J + I2: KT = J * KT1: KJ = K + QT2 - J

154 C(T0, JA2) = (C(T1, JA) + C(T1, KJ) * KC(KT) + S(T1, KJ) * KS(KT)) / 2

156 S(T0, JA2) = (-S(T1, JA) + C(T1, KJ) * KS(KT) - S(T1, KJ) * KC(KT)) / 2

158 NEXT J

160 NEXT I

162 T0 = 1 - T0: T1 = 1 - T0

164 NEXT M

166 T9 = TIMER - T9 ' GET ENDING TIME

170 GOSUB 350 ' DISPLAY SPECTRUM

172 RETURN



349 REM ******  PLOT TRANSFORMED DATA  ******

350 CLS : X0 = 50: Y0 = 10: XSF = 500 * OVSAP / Q2

351 KLOG = LOG(10): YSF = LOG(ASF) / KLOG

352 LINE (X0 - 1, 50)-(X0 - 1, Y0 + 1)' DRAW Y AXIS

353 LINE (X0 + 500, Y0 - 10)-(X0 + 500, Y0 + 1)  ' DRAW Y AXIS

354 LINE (X0, Y0 + 1)-(X0 + 500, Y0 + 1)' DRAW X AXIS

355 LOCATE 2, 55: PRINT "MAX. FREQ. ="; NYQ / (OVSAP * FRACF)

356 ' * DRAW 20 DB TICKS *

358 FOR I = 1 TO 12: YSKT = YSF * 10 * LOG(1 / (10 ^ I)) / KLOG

360 LINE (X0, Y0 - YSKT)-(X0 + 500, Y0 - YSKT)

362 YDB = CINT(.3 + (Y0 - YSKT) / 13.9): IF YDB > 25 THEN 368

364 LOCATE YDB, 2: PRINT USING "###"; 10 * I;

368 NEXT I

370 LINE (X0, Y0)-(X0, Y0)' SET PEN TO ORIGIN

372 SCALE = WSF * FRACF * 2

374 FOR I = 0 TO Q2' PLOT DATA

376 YP = SCALE * SQR(C(T1, I) ^ 2 + S(T1, I) ^ 2) '  FIND RSS OF DATA POINT

380 IF YP = 0 THEN YP = -320: GOTO 384' OUT OF RANGE

382 YP = 20 * LOG(YP) / KLOG' FIND DB VALUE

384 LINE -(X0 + XSF * I, Y0 - YSF * YP)' DRAW LINE

386 NEXT I

388 RETURN



400 REM GENERATE FUNCTION

402 FOR I = QDT TO Q: C(T1, I) = 0: S(T1, I) = 0: NEXT I ' CLEAR ARRAYS

404 MAMP = 2 ^ 15: Y = 0: ISAMP = 0: GAIN = 1 / MAMP

406 OVSAP = 2

410 FOR I = 0 TO QDT ' GENERATE FUNCTION

412 ISAMP = ISAMP + 1: IF ISAMP < OVSAP THEN 428

414 ISAMP = 0

416 Y = GAIN * INT(MAMP * AMP * SIN(F9 * K1 * I))

428 C(T1, I) = Y: S(T1, I) = 0

430 NEXT I

432 IF WTFLG = 2 THEN 450 ' USE WEIGHTING FUNCTION?

440 RETURN



450 ' ****  WEIGHTING FUNCTION  ***

452 FOR I = 0 TO QDT

454 C(T1, I) = C(T1, I) * (SIN(I * PI / QDT) ^ WEXP)

456 NEXT I

458 RETURN



598 REM     *********************************

599 REM     *  GENERATE FUNCTION & ANALYZE  *

600 REM     *********************************

602 CLS : PRINT : PRINT

604 INPUT "PLEASE SPECIFY FREQUENCY "; F8

605 T12 = 1.0594631#

606 F9 = F8 * FRACF * Q2 / NYQ

610 T0 = 1: T1 = 0:

612 GOSUB 400' GENERATE FUNCTION

616 GOSUB 100' PERFORM PFFFT

618 LOCATE 3, 60: REPT = 0

619 PRINT "F = "; : PRINT USING "#####.###"; F9 * NYQ / (Q2 * FRACF)

620 LOCATE 1, 50: PRINT "ESC TO CHANGE SYSTEM: ";

622 A$ = INKEY$: IF A$ = "" THEN 650

624 IF ASC(A$) = 0 THEN GOSUB 630' HANDLE CONTROL KEY

625 IF ASC(A$) = 27 THEN GOSUB 900' MODIFY SYSTEM

626 IF REPT = 1 THEN 616' REPEAT

628 GOTO 600' FROM THE TOP, ONCE MORE, THIS TIME WITH FEELING!



630 REM HANDLE CONTROL KEYS

632 A = ASC(RIGHT$(A$, 1))

634 IF A < 72 OR A > 80 THEN 640 ' REAL CURSOR?

635 IF A = 72 THEN AMP = AMP * 10: IF AMP > 1 THEN AMP = 1

636 IF A = 75 THEN F8 = F8 - .0625

638 IF A = 77 THEN F8 = F8 + .0625

639 IF A = 80 THEN AMP = AMP / 10: IF AMP < .00001 THEN AMP = .00001

640 F9 = F8 * FRACF * Q2 / NYQ

642 GOSUB 400' GENERATE FUN

644 REPT = 1

646 RETURN

' CHECK FOR AUTOSCAN FREQUENCY INCREMENT

650 IF ASCAN = 1 THEN F8 = F8 * T12: IF F8 > NYQ / (OVSAP * FRACF) THEN 655

654 GOTO 605

655 INPUT "ENTER TO CONTINUE"; A$

656 GOTO 600



799 REM *************************************

800 REM ***  ARRAY SIZE (ANALYZER SETUP)  ***

802 REM *************************************

804 CLS : LOCATE 2, 20: PRINT "ANALYZER SETUP MENU"

806 LOCATE 6, 1 ' DISPLAY MENU

820 PRINT SPC(5); "1 = ANALYZE 64    POINT ARRAY": PRINT

822 PRINT SPC(5); "2 = ANALYZE 128   POINT ARRAY": PRINT

824 PRINT SPC(5); "3 = ANALYZE 256   POINT ARRAY": PRINT

826 PRINT SPC(5); "4 = ANALYZE 512   POINT ARRAY": PRINT

828 PRINT SPC(5); "5 = ANALYZE 1024  POINT ARRAY": PRINT

829 PRINT SPC(5); "6 = ANALYZE 2048  POINT ARRAY": PRINT

830 PRINT SPC(5); "7 = ANALYZE 4096  POINT ARRAY": PRINT

832 PRINT SPC(5); "9 = EXIT": PRINT

834 PRINT SPC(10); "MAKE SELECTION :";

836 A$ = INKEY$: IF A$ = "" THEN 836

838 A = VAL(A$): IF A = 9 THEN 848

839 ON A GOSUB 850, 860, 865, 870, 875, 880, 885, 848

840 RETURN

848 RETURN



850 N = 6: Q = 2 ^ (N): NYQ = 22050

852 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8

854 F8 = 16: F9 = F8 * Q / QI: K1 = P2 / Q: QDT = Q / FRACF - 1: ASF = 630

856 FOR I = 0 TO Q2: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I): NEXT' TWIDDLE

858 RETURN



860 N = 7: Q = 2 ^ (N)

862 GOTO 852

865 N = 8: Q = 2 ^ (N)

867 GOTO 852

870 N = 9: Q = 2 ^ (N)

872 GOTO 852

875 N = 10: Q = 2 ^ (N)

877 GOTO 852

880 N = 11: Q = 2 ^ (N)

882 GOTO 852

885 N = 12: Q = 2 ^ (N)

887 GOTO 852



900 CLS : RTFLG = 1: IF ASCAN = 1 THEN PRINT "ASCAN ON" ELSE PRINT "ASCAN OFF"

901 PRINT "                            SYSTEM MENU"

902 PRINT : PRINT "     1 = SUMMARY                5 = AUTO SCAN"

904 PRINT : PRINT "     2 = WEIGHTING FUNCTION     6 = SET FREQUENCY"

906 PRINT : PRINT "     3 = FRACTIONAL FREQUENCY   7 = TERMINATE PROGRAM"

908 PRINT : PRINT "     4 = ARRAY SIZE             8 = EXIT"

910 A$ = INKEY$: IF A$ = "" THEN 910

912 A = ASC(A$): IF A < 49 OR A > 56 THEN 900

914 A = A - 48: ON A GOSUB 920, 930, 970, 800, 995, 960, 918, 990

916 ON RTFLG GOTO 900, 990

918 RTFLG = 3: END



920 CLS

922 PRINT "SYSTEM SUMMARY": PRINT : PRINT

923 PRINT "FRACTIONAL FREQUENCY = 1/"; FRACF

924 PRINT "WEIGHTING FUNCTION = SIN^"; WEXP; " - WEIGHTING IS ";

925 A$ = "ON": IF WTFLG = 1 THEN A$ = "OFF"

926 PRINT A$

927 PRINT "ARRAY SIZE IS "; Q: PRINT

928 INPUT "ENTER TO CONTINUE"; A$

929 RETURN



930 CLS : PRINT "WEIGHTING FUNCTION ON (Y/N)";

932 A$ = INKEY$: IF A$ = "" THEN 932

934 IF A$ = "N" OR A$ = "n" THEN WTFLG = 1: WSF = 1: GOTO 956

936 WTFLG = 2: PRINT ' TURN WEIGHTING ON

938 PRINT "CHANGE WEIGHTING FUNCTION EXPONENT?"

940 A$ = INKEY$: IF A$ = "" THEN 940

942 IF A$ = "N" OR A$ = "n" THEN 952' EXIT

944 PRINT "1 = SIN^2": PRINT "2 = SIN^4": PRINT "3 = SIN^6"

946 A$ = INKEY$: IF A$ = "" THEN 946

948 A = ASC(A$): IF A < 49 OR A > 51 THEN 946

950 A = A - 48: WEXP = 2 * A' FIND EXPONENT

952 WSF = 2: IF A = 2 THEN WSF = 8 / 3

954 IF A = 3 THEN WSF = 16 / 5

956 RETURN



960 ' ***   SET FREQUENCY   ***

962 INPUT "ENTER FREQUENCY OF SAMPLING RATE (IN Hz)"; FSAP

964 NYQ = FSAP / 2' NYQ = 1/2 SAMPLING RATE

966 RETURN



970 CLS : PRINT : PRINT "SELECT FRACTIONAL FREQUENCY FOR ANALYSIS"

972 PRINT : PRINT "1 = 1/1                           4 = 1/8  "

974 PRINT "2 = 1/2                           5 = 1/16"

976 PRINT "3 = 1/4                           6 = 1/32"

978 A$ = INKEY$: IF A$ = "" THEN 978

980 A = ASC(A$): IF A < 49 OR A > 54 THEN 978

982 A = A - 49: FRACF = 2 ^ A

984 CLS : LOCATE 10, 20: PRINT "YOU MUST RE-SELECT ARRAY SIZE"

986 LOCATE 20, 2: INPUT "ENTER TO CONTINUE"; A$

988 RETURN



990 RTFLG = 2: RETURN



995 ASCAN = 1 - ASCAN: RETURN



999 END



10000 CLS : PRINT : PRINT SPC(20); "OPERATING INFORMATION": PRINT : PRINT

PRINT SPC(10); "1. UP/DWN CURSORS ATTENUATE INPUT SIGNAL."

PRINT SPC(10); "   (NOTE THAT 100DB ATTENUATION YIELDS ~SQUARE WAVE SPECTRUMS.)"

PRINT SPC(10); "2. LEFT/RIGHT CURSORS SHIFT FREQUENCY OF INPUT SIGNAL"

PRINT SPC(10); "3. USE Esc TO CHANGE ARRAY SIZE, ETC."

PRINT SPC(10); "4. CHANGING ARRAY SIZE AND FREQUENCY FRACTION CHANGES FREQUENCY SPAN."

PRINT SPC(10); "5. CHANGING WEIGHTING CHANGES RESOULTION."

PRINT SPC(10); "6. LARGER ARRAYS RUN SLOWER. (SEE CH.13 - SEC13.4 FOR HELP HERE.)"

PRINT SPC(10); "7. AUTO SCAN CAN BE INITIATED FROM SYSTEM MENU (UNDER Esc)"

PRINT : PRINT

INPUT "ENTER TO CONTINUE"; A$

RETURN



